home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / tls / tls085.solintel.Z / tls085.solintel / lib / vtcl / tests / boxbuttons.tcl < prev    next >
Encoding:
Text File  |  1995-07-20  |  4.8 KB  |  190 lines
  1. # CVS $Id: boxbuttons.tcl,v 1.3 1995/02/03 16:54:18 zibi Exp $
  2.  
  3. #
  4. # Program to test buttons that appear on the bottom of
  5. # fileselection, selection and message boxes.
  6. #
  7. #
  8.  
  9. global ok cancel help apply 
  10. global okCallback cancelCallback helpCallback applyCallback 
  11. global okLabel cancelLabel helpLabel applyLabel 
  12.  
  13. set ok             ""
  14. set cancel         ""
  15. set help           ""
  16. set apply          ""
  17.  
  18. set okCallback     ""
  19. set cancelCallback ""
  20. set helpCallback   ""
  21. set applyCallback  ""
  22.  
  23. set okLabel        ""
  24. set cancelLabel    ""
  25. set helpLabel      ""
  26. set applyLabel     ""
  27.  
  28. proc quitCB {cbs} {
  29.     VtClose
  30.     exit 0
  31. }
  32.  
  33. proc oneArgCB {option parameter cbs} {
  34.     global okCallback cancelCallback helpCallback applyCallback 
  35.     global okLabel cancelLabel helpLabel applyLabel 
  36.  
  37.     if {[keylget cbs set]} {
  38.         eval set $option [list "-$option $parameter"]
  39.     } else {
  40.         eval set $option [list ""]
  41.     }
  42. }
  43.  
  44. proc noArgCB {option cbs} {
  45.     global ok cancel help apply 
  46.  
  47.     if {[keylget cbs set]} {
  48.         eval set $option [list -$option]
  49.     } else {
  50.         eval set $option [list ""]
  51.     }
  52. }
  53.  
  54. proc dummyCB {cbs} {
  55. }
  56.  
  57. proc destroyCB {cbs} {
  58.     VtDestroyDialog [keylget cbs widget]
  59. }
  60.  
  61. proc showSelCB {cbs} {
  62.     global ok cancel help apply sb
  63.     global okCallback cancelCallback helpCallback applyCallback 
  64.     global okLabel cancelLabel helpLabel applyLabel 
  65.  
  66.     set but [keylget cbs widget]
  67.  
  68.     set sb [eval VtSelectionDialog $but.sb \
  69.                        $ok $okCallback $okLabel \
  70.                        $cancel $cancelCallback $cancelLabel \
  71.                        $help $helpCallback $helpLabel \
  72.                        $apply $applyCallback $applyLabel \
  73.                         [list -itemList { {one}
  74.                                 {two}
  75.                                 {three}}]]
  76.     VtShow $sb
  77. }
  78.  
  79.  
  80. proc showFsbCB {cbs} {
  81.     global ok cancel help apply sb
  82.     global okCallback cancelCallback helpCallback applyCallback 
  83.     global okLabel cancelLabel helpLabel applyLabel 
  84.  
  85.     set but [keylget cbs widget]
  86.  
  87.     set fsb [eval VtFileSelectionDialog $but.sb \
  88.                        $ok $okCallback $okLabel \
  89.                        $cancel $cancelCallback $cancelLabel \
  90.                        $help $helpCallback $helpLabel \
  91.                        $apply $applyCallback $applyLabel]
  92.     VtShow $fsb
  93. }
  94.  
  95. proc showMsgCB {cbs} {
  96.     global ok cancel help apply sb
  97.     global okCallback cancelCallback helpCallback applyCallback 
  98.     global okLabel cancelLabel helpLabel applyLabel 
  99.  
  100.  
  101.     set but [keylget cbs widget]
  102.  
  103.     set msg [eval VtMessageDialog $but.sb \
  104.                        $ok $okCallback $okLabel \
  105.                        $cancel $cancelCallback $cancelLabel \
  106.                        $help $helpCallback $helpLabel \
  107.                        $apply $applyCallback $applyLabel \
  108.                         [list -message "Hi There"]]
  109.     VtShow $msg
  110. }
  111.  
  112.  
  113. #
  114. # Start Program
  115. #
  116. #
  117.  
  118. set app [VtOpen buttons]
  119.  
  120. set fn [VtStartForm $app.form -title "Button test" ]
  121.  
  122. set rc1 [VtRowColumn $fn.rc1   \
  123.         -borderWidth 2 \
  124.         -topSide FORM \
  125.         -leftSide FORM \
  126.         -topOffset 20  \
  127.         -leftOffset 40 \
  128.                 -CHARM_topOffset 1 \
  129.                 -CHARM_leftOffset 1 ]
  130. VtToggleButton $rc1.but1 -label "ok"      -callback "noArgCB ok"
  131. VtToggleButton $rc1.but2 -label "cancel"  -callback "noArgCB cancel"
  132. VtToggleButton $rc1.but3 -label "apply"   -callback "noArgCB apply"
  133. VtToggleButton $rc1.but4 -label "help"    -callback "noArgCB help"
  134.  
  135. set rc2 [VtRowColumn $fn.rc2   \
  136.         -borderWidth 2 \
  137.         -topSide FORM \
  138.         -leftSide $rc1 \
  139.         -topOffset 20  \
  140.         -leftOffset 40 \
  141.                 -CHARM_topOffset 1 \
  142.                 -CHARM_leftOffset 1 ]
  143. VtToggleButton $rc2.but1 -label "okCallback"  \
  144.              -callback "oneArgCB okCallback dummyCB"
  145. VtToggleButton $rc2.but2 -label "cancelCallback" \
  146.              -callback "oneArgCB cancelCallback dummyCB"
  147. VtToggleButton $rc2.but3 -label "applyCallback"  \
  148.              -callback "oneArgCB applyCallback dummyCB"
  149. VtToggleButton $rc2.but4 -label "helpCallback"   \
  150.              -callback "oneArgCB helpCallback dummyCB"
  151.  
  152. set rc3 [VtRowColumn $fn.rc3   \
  153.         -borderWidth 2 \
  154.         -topSide FORM \
  155.         -leftSide $rc2 \
  156.         -topOffset 20  \
  157.         -leftOffset 40 \
  158.                 -CHARM_topOffset 1 \
  159.                 -CHARM_leftOffset 1 ]
  160. VtToggleButton $rc3.but1 -label "okLabel" \
  161.              -callback "oneArgCB okLabel OK"
  162. VtToggleButton $rc3.but2 -label "cancelLabel" \
  163.              -callback "oneArgCB cancelLabel CANCEL"
  164. VtToggleButton $rc3.but3 -label "applyLabel"  \
  165.              -callback "oneArgCB applyLabel APPLY"
  166. VtToggleButton $rc3.but4 -label "helpLabel"   \
  167.              -callback "oneArgCB helpLabel HELP"
  168.  
  169. set rc_bottom [VtRowColumn $fn.rc_bottom  \
  170.         -spacing 5 \
  171.         -leftSide $rc1 \
  172.         -topOffset 20 \
  173.         -leftOffset 30 \
  174.         -below $rc2 \
  175.                 -CHARM_topOffset 1 \
  176.                 -CHARM_spacing 0 \
  177.                 -CHARM_leftOffset 1 ]
  178. VtPushButton $rc_bottom.show    -label "Show Selection Dialog" \
  179.                     -callback showSelCB
  180. VtPushButton $rc_bottom.showfsb -label "Show FileSelection Dialog" \
  181.                     -callback showFsbCB
  182. VtPushButton $rc_bottom.showMsg -label "Show Message Dialog" \
  183.                     -callback showMsgCB
  184. VtPushButton $rc_bottom.quit -label "Quit" -labelCenter \
  185.                  -callback quitCB
  186.  
  187.  
  188. VtShow $fn
  189. VtMainLoop
  190.